BBS in a Box 7/BBS in a Box - Macintosh - Volume VII (BBS in a Box) (January 1993).iso/Files/Prog/T/TileCDEF.cpt/TileTest.pas

Pascal/Delphi Source File | 1989-02-07 | 5KB | 209 lines

Program TileTest;

{$U-}
{$R TileTest.rsrc}

Uses
  MemTypes,QuickDraw,OSIntf,ToolIntf,Sound;

Const
  AppleMenu     = 128;
  FileMenu      = 129;
  EditMenu      = 130;

Var
  myMenus       : array [AppleMenu..EditMenu] of MenuHandle;
  GrowArea      : Rect;
  theWindow     : WindowPtr;
  theControl    : ControlHandle;
  RabbitControl : ControlHandle;
  PigControl    : ControlHandle;

Procedure ProcessMenu(codeWord : Longint);
Var
  menuNum       : Integer;
  itemNum       : Integer;
  NameHolder    : Str255;
  dummy         : Integer;
Begin
  if codeWord = 0 then Exit;
  menuNum:= HiWord(codeWord);
  itemNum:= LoWord(codeWord);
  case menuNum of
    AppleMenu :
      begin
        GetItem(myMenus[AppleMenu],itemNum,NameHolder);
        dummy := OpenDeskAcc(NameHolder);
      end;
    FileMenu : ExitToShell;
    EditMenu : if NOT SystemEdit(itemNum - 1) then ;
  end;
  HiliteMenu(0);
End;

Procedure DealWithMouseDowns(theEvent: EventRecord);
Var
  whichWindow   : WindowPtr;
  mouseLoc      : Point;
  windowLoc     : Integer;
  position      : LongInt;
  whichControl  : ControlHandle;
  resHdl        : Handle;
  errCode       : OSErr;
Begin
  mouseLoc:= theEvent.where;
  windowLoc:= FindWindow(mouseLoc,whichWindow);
  case windowLoc of
    inMenuBar   : ProcessMenu(MenuSelect(mouseLoc));
    inSysWindow : SystemClick(theEvent,whichWindow);
    inDrag      : DragWindow(whichWindow,mouseLoc,screenBits.bounds);
    inZoomIn,inZoomOut :
      begin
        if TrackBox(whichWindow,mouseLoc,windowLoc) then begin
          SetPort(whichWindow);
          ClipRect(whichWindow^.portRect);
          EraseRect(whichWindow^.portRect);
          ZoomWindow(whichWindow,windowLoc,true);
          InvalRect(whichWindow^.portRect);
        end;
      end;
    inGrow :
      begin
        position:= GrowWindow(whichWindow,mouseLoc,GrowArea);
        if position <> 0 then begin
          SizeWindow(whichWindow,loword(position),hiword(position),false);
          SetPort(whichWindow);
          InvalRect(whichWindow^.portRect);
        end;
      end;
    inGoAway :
      begin
        if TrackGoAway(whichWindow,mouseLoc) then ExitToShell;
      end;
    inContent :
      begin
        if whichWindow <> FrontWindow then
          SelectWindow(whichWindow)
        else begin
          SetPort(whichWindow);
          GlobalToLocal(mouseLoc);
          if FindControl(mouseLoc,whichWindow,whichControl) = 0 then Exit;
          if TrackControl(whichControl,mouseLoc,nil) = 0 then Exit;
          if whichControl = RabbitControl then begin
            resHdl:= GetResource('snd ',128);
            errCode:= SndPlay(nil,resHdl,true);
            ReleaseResource(resHdl);
          end;
       end;
     end;
  end;
End;

Procedure DealWithKeyDowns(theEvent: EventRecord);
Var
  CharCode  : char;
Begin
  CharCode:= CHR(BitAnd(theEvent.message,charCodeMask));
  if BitAnd(theEvent.modifiers,CmdKey) = CmdKey
    then ProcessMenu(MenuKey(CharCode));
End;

Procedure DealWithActivates(theEvent: EventRecord);
Var
  TargetWindow    : WindowPtr;
Begin
  TargetWindow := WindowPtr(theEvent.message);
  if Odd(theEvent.modifiers)
    then SetPort(TargetWindow);
End;

Procedure DealWithUpdates(theEvent: EventRecord);
Var
  UpDateWindow  : WindowPtr;
  tempPort      : WindowPtr;
Begin
  UpDateWindow := WindowPtr(theEvent.message);
  GetPort(tempPort);
  SetPort(UpDateWindow);
  BeginUpDate(UpDateWindow);
    EraseRect(UpDateWindow^.portRect);
    DrawControls(UpDateWindow);
  EndUpDate(UpDateWindow);
  SetPort(tempPort);
End;

Procedure MainEventLoop;
Var
  Event        : EventRecord;
Begin
  repeat
    SystemTask;
    if GetNextEvent(everyEvent, Event) then
      case Event.what of
        mouseDown   : DealWithMouseDowns(Event);
        AutoKey     : DealWithKeyDowns(Event);
        KeyDown     : DealWithKeyDowns(Event);
        ActivateEvt : DealWithActivates(Event);
        UpdateEvt   : DealWithUpdates(Event);
      end; {case}
  until FALSE;
End;

Procedure SetupMacintosh;
Begin
  MaxApplZone;
  MoreMasters;
  MoreMasters;
  MoreMasters;

  FlushEvents(everyEvent,0);

  InitGraf(@thePort);
  InitFonts;
  InitWindows;
  InitMenus;
  TEInit;
  InitDialogs(nil);
End;

Procedure SetupMenus;
Var
  index    : Integer;
Begin
  for index:= AppleMenu to EditMenu do begin
    myMenus[index] := GetMenu(index);
    InsertMenu(myMenus[index],0);
  end;
  AddResMenu(myMenus[AppleMenu],'DRVR');
  DrawMenuBar;
End;

Procedure SetupStuff;
Var
  tempRect  : Rect;
Begin
  with screenBits.bounds do
    SetRect(GrowArea,100,100,right,bottom);

  SetRect(tempRect,50,50,400,300);
  theWindow:= NewWindow(nil,tempRect,'hello',true,8,pointer(-1),true,0);

  RabbitControl:= GetNewControl(128,theWindow);
  PigControl:= GetNewControl(129,theWindow);

  SetRect(tempRect,100,100,164,164);
  theControl:= NewControl(theWindow,tempRect,'',true,129,0,0,160,0);

  HiliteControl(theControl,255);
End;

Begin
  SetupMacintosh;

  SetupMenus;
  SetupStuff;
  InitCursor;

  MainEventLoop;
End.